Visual Basic Source Code/Visual Basic Source Code.iso/vbsource/vbpxen/vvdbmod.bas

BASIC Source File | 1991-10-07 | 8KB | 236 lines

'
'   Written by Steve Jackson
'              9152 Brabham Dr.
'              Huntington Beach, CA 92646
'
'   This is meant to be called from your form objects.  In turn, these
'   functions call routines in PXMODULE.BAS that access Paradox.  I
'   tried to isolate all Paradox specific code there in case you want
'   to change your app to some other DBMS later (SQL Server, xbase, etc.)
'   or it you don't like it and want to change it...
'
Function StartUp () As Integer
    '
    '  Initialize the database system, with a user id
    '  open all tables
    '
    rc = DBInit("vvdemo")
    '
    '  If table open fails, pxerror() routine displays a message,
    '  then we shut down
    '
    '  If you create an EXE for this program,
    '  you can code this to get directory where
    '  the program is.  Otherwise use the global constant
    '  because at development time CurDir$ tells you where
    '  Visual Basic is, not your project.
    '
    '  ***** db_dir$ = CurDir$  *****
    '
    db_dir$ = DEFAULT_DB_DIR
    '
    tbl_name$ = db_dir$ + "\customer"
    rc = TableOpen(CUSTOMER_TABLE, tbl_name$)
    If rc Then
        rc = DBExit()
        End
    End If

    tbl_name$ = db_dir$ + "\item"
    rc = TableOpen(ITEM_TABLE, tbl_name$)
    If rc Then
        rc = DBExit()
        End
    End If

    StartUp = DB_OK
End Function

Function Shutdown () As Integer
    '
    '  Terminate the database system, close tables
    '  this is invoked at program end time
    '
    rc = DBExit()
    Shutdown = rc
End Function

Function GetCustomerRec (ByVal Action%) As Integer
    '
    '   Get the customer record and move all fields to
    '   a record buffer that is global
    '
    If Action% = DBKEYED Then
        rc = PutAlphaField(CUSTOMER_TABLE, 1, custrec.custnumber)
    End If

    rc = GetRec(CUSTOMER_TABLE, Action%)
    '
    '  Assume the error handling function traps fatal errors and
    '  ends the program.  Here we assume any error is of the expected
    '  variety, such as not-found, end-of-file, duplicate-key, etc.
    '
    If rc = DB_NOTFOUND Then
        GetCustomerRec = rc
        Beep
        Msg$ = "Customer not found for this customer number"
        MsgBox Msg$, MB_ICONINFORMATION, "Get Customer"
        Exit Function
    End If
    '
    '  Assume that if there is still and error, it is at end or
    '  start of file.  Just beep, but do not display any msg
    '
    If rc Then
        GetCustomerRec = rc
        Beep
        Exit Function
    End If
    '
    '  Move fields from paradox to the record buffer
    '  The fields are NOT on the form at this point
    '
    rc = GetAlphaField(CUSTOMER_TABLE, 1, custrec.custnumber)
    rc = GetAlphaField(CUSTOMER_TABLE, 2, custrec.lastname)
    rc = GetAlphaField(CUSTOMER_TABLE, 3, custrec.firstname)
    rc = GetAlphaField(CUSTOMER_TABLE, 4, custrec.address)
    rc = GetAlphaField(CUSTOMER_TABLE, 5, custrec.city)
    rc = GetAlphaField(CUSTOMER_TABLE, 6, custrec.zip)
    rc = GetShortField(CUSTOMER_TABLE, 7, custrec.tapes_out)
    rc = GetNumField(CUSTOMER_TABLE, 8, custrec.total_spent)

    GetCustomerRec = DB_OK
End Function

Function UpdateCustomerRec () As Integer
    '
    '  Write the current record back to the database.
    '  Assume no-one else has changed the positioning since
    '  the time we got the record, and when the update takes place.
    '  Note:  this may be a dangerous assumption in Windows...
    '
    rc = PutAlphaField(CUSTOMER_TABLE, 1, custrec.custnumber)
    rc = PutAlphaField(CUSTOMER_TABLE, 2, custrec.lastname)
    rc = PutAlphaField(CUSTOMER_TABLE, 3, custrec.firstname)
    rc = PutAlphaField(CUSTOMER_TABLE, 4, custrec.address)
    rc = PutAlphaField(CUSTOMER_TABLE, 5, custrec.city)
    rc = PutAlphaField(CUSTOMER_TABLE, 6, custrec.zip)
    rc = PutShortField(CUSTOMER_TABLE, 7, custrec.tapes_out)
    rc = PutNumField(CUSTOMER_TABLE, 8, custrec.total_spent)

    rc = UpdateRec(CUSTOMER_TABLE)
    UpdateCustomerRec = rc

    If rc Then
        Beep
        Msg$ = "Update failed, reason code: " + Str$(rc)
        MsgBox Msg$, MB_ICONEXCLAMATION, "Update Customer"
    End If

    rc = UnlockRec(CUSTOMER_TABLE)
End Function

Function AddCustomerRec () As Integer
    '
    '  Write the record to the database.
    '  Assume no-one else has already added one with this key.
    '  Note:  this may be a dangerous assumption in Windows...
    '
    rc = PutAlphaField(CUSTOMER_TABLE, 1, custrec.custnumber)
    rc = PutAlphaField(CUSTOMER_TABLE, 2, custrec.lastname)
    rc = PutAlphaField(CUSTOMER_TABLE, 3, custrec.firstname)
    rc = PutAlphaField(CUSTOMER_TABLE, 4, custrec.address)
    rc = PutAlphaField(CUSTOMER_TABLE, 5, custrec.city)
    rc = PutAlphaField(CUSTOMER_TABLE, 6, custrec.zip)
    rc = PutShortField(CUSTOMER_TABLE, 7, custrec.tapes_out)
    rc = PutNumField(CUSTOMER_TABLE, 8, custrec.total_spent)

    rc = AddRec(CUSTOMER_TABLE)
    AddCustomerRec = rc
    '
    '  assume serious errors were trapped in pxerror()
    '  if the add fails, assume it is a duplicate key
    '
    If rc Then
        Beep
        Msg$ = "ADD failed - there is already a customer with this number"
        MsgBox Msg$, MB_ICONINFORMATION, "Add Customer"
    End If

    AddCustomerRec = rc
End Function

Function DeleteCustomerRec () As Integer
    '
    '  Write the current record back to the database.
    '  Assume no-one else has changed the positioning since
    '  the time we got the record, and when the update takes place.
    '  Note:  this may be a dangerous assumption in Windows...
    '
    '  Just move the key field to the record buffer
    '
    rc = PutAlphaField(CUSTOMER_TABLE, 1, custrec.custnumber)

    rc = DeleteRec(CUSTOMER_TABLE)
    '
    '  assume serious errors were trapped in pxerror()
    '  if the delete fails, assume it was already deleted
    '
    If rc Then
        Beep
        Msg$ = "DELETE failed - Customer was already deleted"
        MsgBox Msg$, MB_ICONEXLAMATION, "Delete Customer"
    End If

    DeleteCustomerRec = rc
End Function

Function GetCustomerRecForUpdate () As Integer
    '
    '   Get the customer record by key value,
    '   and place a record lock on it.
    '
    '   Move all fields to a record buffer that is global
    '
    rc = PutAlphaField(CUSTOMER_TABLE, 1, custrec.custnumber)

    rc = GetRec(CUSTOMER_TABLE, DB_KEYED)
    '
    '  Assume the error handling function traps fatal errors and
    '  ends the program.  Here we assume any error is of the expected
    '  variety, such as not-found, end-of-file, duplicate-key, etc.
    '
    If rc Then
        GetCustomerRecForUpdate = rc
        Beep
        Msg$ = "Customer record was not found for this customer number"
        MsgBox Msg$, MB_ICONINFORMATION, "Get Customer"
        Exit Function
    End If
    '
    '  Place the lock,
    '    if it fails, try again until user quits
    '
    rc = LockRec(CUSTOMER_TABLE)
    If rc Then
        GetCustomerRecForUpdate = rc
        Msg$ = "Customer record is locked by someone else"
        MsgBox Msg$, MB_ICONINFORMATION, "Get Customer"
        Exit Function
    End If


    rc = GetAlphaField(CUSTOMER_TABLE, 1, custrec.custnumber)
    rc = GetAlphaField(CUSTOMER_TABLE, 2, custrec.lastname)
    rc = GetAlphaField(CUSTOMER_TABLE, 3, custrec.firstname)
    rc = GetAlphaField(CUSTOMER_TABLE, 4, custrec.address)
    rc = GetAlphaField(CUSTOMER_TABLE, 5, custrec.city)
    rc = GetAlphaField(CUSTOMER_TABLE, 6, custrec.zip)
    rc = GetShortField(CUSTOMER_TABLE, 7, custrec.tapes_out)
    rc = GetNumField(CUSTOMER_TABLE, 8, custrec.total_spent)

    GetCustomerRecForUpdate = DB_OK
End Function